home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
L' Effet Pommier 3
/
L'Effet Pommier - Volume 03.iso
/
Programmation
/
Alpha ƒ
/
Tcl
/
SystemCode
/
fill.tcl
< prev
next >
Wrap
Text File
|
1996-01-10
|
8KB
|
312 lines
####################################################################
#
# Much by Vince Darley.
#
# created: 3/7/95 {7:49:47 pm}
# last update: 6/10/95 {10:41:50 am}
# Author: Vince Darley
# E-mail: <mailto:vince@das.harvard.edu>
# mail: Division of Applied Sciences, Harvard University
# Oxford Street, Cambridge MA 02138, USA
# <http://www.das.harvard.edu/users/students/Vincent_Darley/>
#
####################################################################
proc fillParagraph {} {
if {[getPos] == [selEnd]} {
fillOneParagraph
} else {
set start [getPos]
set end [selEnd]
set p $start
while { $p < $end } {
goto $p
set p [fillParagraph]
}
goto $start
}
}
proc fillOneParagraph {} {
global leftFillColumn fillColumn
getWinInfo a
set tabs $a(tabsize)
set pos [getPos]
# find nearest text to grab hold of
# to try and maintain cursor position
if { [lookAt $pos] != " " } {
set grab [getText $pos [expr $pos +20]]
set grabdiff 0
} else {
backwardWord
set p2 [getPos]
set grab [getText $p2 [expr $pos +20]]
set grabdiff [expr $pos - $p2]
}
set start [paraStart $pos]
set end [paraFinish $pos]
# get the leading whitespace of the current line
set res [search -s -n -f 1 -r 1 "^\[ \t\]*" [lineStart $pos]]
# convert it to minimal form: tabs then spaces, stored in 'front'
set sp [string range " " 1 $tabs ]
regsub -all $sp [eval getText $res] "\t" front
regsub -all "\[ \]+\t" $front "\t" front
# get the length of the indent
regsub -all "\t" $front $sp lfront
set left [string length $lfront]
# fill the text
regsub -all "\[ \t\r\]+" [string trim [getText $start $end]] " " text
# turn single spaces at end of sentences into double
regsub -all {(([^A-Z@]|\\@)[.?!]([])]|'|'')?) } $text {\1 } text
# temporarily adjust the fillColumns
set ol $leftFillColumn
set or $fillColumn
set leftFillColumn 0
set fillColumn [expr $fillColumn - $left]
# break and indent the paragraph
regsub -all "\r" "\r[string trimright [breakIntoLines $text]]" "\r${front}" text
# don't replace if nothing's changed
if { "$text\r" != "\r[getText $start $end]" } {
replaceText $start $end "[string range "$text" 1 end]\r"
set p [fillFind $text $grab]
if { $p == -1 } {
goto $pos
} else {
goto [expr $start + $p + $grabdiff -1]
}
}
set leftFillColumn $ol
set fillColumn $or
# in case we wish to fill a region
return $end
}
proc fillFind { text search } {
if { ![string length $search] } {
return -1
}
set pos [string first $search $text]
if { $pos != -1 } {
return $pos
} else {
set search [string range $search 0 [expr [string length $search] -5]]
return [fillFind $text $search]
}
}
set texParaCommands {begin|end|(protect\\)?label|(sub)*section|subfigure|paragraph|center(line|ing)|caption|chapter|item|bibitem|intertext}
proc paraStart {pos} {
global mode texParaCommands
if {$pos == [maxPos]} {incr pos -1}
set pos [lineStart $pos]
if { $mode == "TeX" || $mode == "Bib" } {
set startPara {(\\\\[ \t]*$|^[ \t]*(\$\$[ \t]*|(%+.*|(\\(}
append startPara $texParaCommands {)(\[.*\]|\{.*\}|Ñ)*[ \t]*)+))?$)}
} else {
set startPara {^([ \t]*|([\\%].*))$}
}
set res [search -s -n -f 0 -r 1 -l 0 "$startPara" $pos]
if {![string length $res] || $res == "0 0" } {return 0}
if { [lindex $res 0] == $pos } {
return $pos
} else {
return [nextLineStart [lindex $res 0]]
}
}
proc paraFinish {pos} {
global mode texParaCommands
set pos [lineStart $pos]
set end [maxPos]
if { $mode == "TeX" || $mode == "Bib" } {
set endPara {^[ \t]*(\$\$[ \t]*|(%+.*|(\\(}
append endPara $texParaCommands {)(\[.*\]|\{.*\}|Ñ)*[ \t]*)+))?$}
} else {
set endPara {^([ \t]*|([\\%].*))$}
}
set res [search -s -n -f 1 -r 1 -l $end "$endPara" $pos]
if {![string length $res]} {return $end}
if { [lindex $res 0] == $pos } {
return [nextLineStart $pos]
}
# a line which ends in '\\' or '%' also signifies end of line in tex mode
if { $mode == "TeX" || $mode == "Bib" } {
set res2 [search -s -n -f 1 -r 1 -l $end {(\\\\|%)[ \t]*$} $pos]
if [string length $res2] {
if { [lindex $res2 0] < [lindex $res 0] } {
return [nextLineStart [lindex $res2 0]]
}
}
}
return [lindex $res 0]
}
proc sentenceParagraph {} {
set pos [getPos]
set start [paraStart $pos]
set finish [paraFinish $pos]
set t [string trim [getText $start $finish]]
set period [regexp {\.$} $t]
regsub -all "\[ \t\r\]+" $t " " text
regsub -all {\. } $text "╞" text
set result ""
foreach line [split [string trimright $text {.}] "╞"] {
if {[string length $line]} {
append result [breakIntoLines $line] ".\r"
}
}
if {!$period && [regexp {\.\r} $result]} {
set result [string trimright $result ".\r"]
append result "\r"
}
if {$result != [getText $start $finish]} {
replaceText $start $finish $result
}
goto $pos
}
proc getEndpts {} {
if {[getPos] == [selEnd]} {
set start [getPos]
set finish [getMark]
if {$start > $finish} {
set temp $start
set start $finish
set finish $temp
}
} else {
set start [getPos]
set finish [selEnd]
}
return [list $start $finish]
}
proc fillRegion {} {
global leftFillColumn
set ends [getEndpts]
set start [lineStart [lindex $ends 0]]
set finish [lindex $ends 1]
goto $start
set text [fillText $start $finish]
replaceText $start $finish [format "%$leftFillColumn\s" ""] $text "\r"
}
proc wrapParagraph {} {
set pos [getPos]
set start [paraStart $pos]
set finish [paraFinish $pos]
goto $start
wrapText $start $finish
goto $pos
}
proc wrapRegion {} {
set ends [getEndpts]
set start [lineStart [lindex $ends 0]]
set finish [lindex $ends 1]
if {$start == $finish} {
set finish [maxPos]
}
wrapText $start $finish
}
# Remove text from window, transform, and insert back into window.
proc fillText {from to} {
set text [getText $from $to]
regexp {^ *} $text front
set text [string trim $text]
regsub -all "\[ \t\r\]+" $text " " text
regsub -all {(\.|\?|\!) } $text {\1 } text
regsub -all "\r" [string trimright [breakIntoLines $text]] "\r${front}" text
return $front$text
}
proc paragraphToLine {} {
global fillColumn
global leftFillColumn
set fc $fillColumn
set lc $leftFillColumn
set fillColumn 10000
set leftFillColumn 0
fillRegion
set fillColumn $fc
set leftFillColumn $lc
}
proc lineToParagraph {} {
global fillColumn
global leftFillColumn
set fc $fillColumn
set fillColumn 75
set lc $leftFillColumn
set leftFillColumn 0
fillRegion
set fillColumn $fc
set leftFillColumn $lc
}
#set sentEnd {[.!?](\r| +)}
set sentEnd {(\r\r|[.!?](\r| +))}
set sentBeg {[\r ][A-Z]}
proc nextSentence {} {
global sentBeg sentEnd
if {![catch {search -s -f 1 -r 1 $sentEnd [getPos]} mtch]} {
if {![catch {search -s -f 1 -r 1 -i 0 $sentBeg [expr [lindex $mtch 1]-1]} mtch]} {
goto [expr [lindex $mtch 0]+1]
}
}
}
proc prevSentence {} {
global sentBeg sentEnd
if {[catch {search -s -f 0 -r 1 $sentBeg [expr [getPos]-2]} mtch]} return
if {![catch {search -s -f 0 -r 1 $sentEnd [lindex $mtch 1]} mtch]} {
if {![catch {search -s -f 1 -r 1 -i 0 $sentBeg [expr [lindex $mtch 1]-1]} mtch]} {
goto [expr [lindex $mtch 0]+1]
}
}
}
# 5 730 845 955
#===============================================================================
# Called by Alpha to do "soft wrapping"
proc softProc {pos start next} {
global leftFillColumn
goto $start
set finish [paraFinish $start]
set text [fillText $start $finish]
if {"${text}\r" != [getText $start $finish]} {
replaceText $start $finish [format "%$leftFillColumn\s" ""] $text "\r"
return 1
} else {
return 0
}
}